Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue43/tooltips/DBHntGrd.pas

Pascal/Delphi Source File | 1999-01-25 | 5.5 KB | 206 lines

unit DBHntGrd;
{$ifdef Ver80} { Delphi 1.0x }
  {$define DelphiLessThan3}
{$endif}
{$ifdef Ver90} { Delphi 2.0x }
  {$define DelphiLessThan3}
{$endif}
{$ifdef Ver93} { C++ Builder 1.0x }
  {$define DelphiLessThan3}
{$endif}

interface

uses
  WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids;

type
  THintDBGrid = class(TDBGrid)
  private
    FHintWnd: THintWindow;
  protected
    function CalcHintRect(MaxWidth: Integer;
      const AHint: string; HintWnd: THintWindow): TRect;
    procedure DoHint(X, Y: Integer);
  public
    procedure CMMouseEnter(var Msg: TMessage); message cm_MouseEnter;
    procedure CMMouseLeave(var Msg: TMessage); message cm_MouseLeave;
    procedure WMMouseMove(var Msg: TWMMouseMove); message wm_MouseMove;
  end;

{$ifdef DelphiLessThan3}
  { The hint window in Delphi 1 and 2 would beep if you clicked it }
  { These modifications fix that }
  TCustomHint = class(THintWindow)
  private
    procedure WMNCHitTest(var Msg: TWMNCHitTest);
      message wm_NCHitTest;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

{ The private routine Forms.ForegroundTask was only made }
{ available in Delphi 3. This is a cheap'n'nasty version of it }
function ForegroundTask: Boolean;
{$endif}

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Clinic', [THintDBGrid]);
end;

{$ifdef DelphiLessThan3}
{ The private routine Forms.ForegroundTask was only made }
{ available in Delphi 3. This is a cheap'n'nasty version of it }
function ForegroundTask: Boolean;
begin
  Result := FindControl(GetActiveWindow) <> nil
end;
{$endif}

{ THintStringGrid }

function THintDBGrid.CalcHintRect(MaxWidth: Integer;
  const AHint: string; HintWnd: THintWindow): TRect;
{$ifdef DelphiLessThan3}
var
  Buf: array[0..511] of Char;
begin
  Result := Rect(0, 0, MaxWidth, 0);
  { Ask Windows to do the hard calculation work }
  DrawText(HintWnd.Canvas.Handle, StrPCopy(Buf, AHint), -1, Result,
    DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  { Add some breathing room }
  Inc(Result.Right, 6);
  Inc(Result.Bottom, 2);
{$else}
begin
  { Delphi 3+ makes this method available }
  Result := HintWnd.CalcHintRect(Screen.Width, AHint, nil)
{$endif}
end;

procedure THintDBGrid.CMMouseEnter(var Msg: TMessage);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  DoHint(Pt.X, Pt.Y)
end;

procedure THintDBGrid.CMMouseLeave(var Msg: TMessage);
begin
  inherited;
  { Could destroy it, but this takes less time }
  if Assigned(FHintWnd) then
    FHintWnd.ReleaseHandle;
end;

procedure THintDBGrid.DoHint(X, Y: Integer);
const
  TextOffset = 2;
var
  Col, Row, LogCol, LogRow: Longint;
  R, OldR: TRect;
  Pt: TPoint;
  GPt: TGridCoord;
  OldActive: Integer;
  Text: String;
begin
  { Check cell under mouse }
  GPt := MouseCoord(X, Y);
  Col := GPt.X;
  Row := GPt.Y;
  LogCol := Col;
  LogRow := Row;
  { Title row needs to be taken account of }
  if dgTitles in Options then Dec(LogRow);
  { Indicator column needs to be taken account of }
  if dgIndicator in Options then Dec(LogCol);
  Text := '';
  if (LogCol >= 0) and (LogRow >= 0) then
  begin
    OldActive := DataLink.ActiveRecord;
    try
      Datalink.ActiveRecord := LogRow;
    {$ifdef Win32}
      Text := Columns[LogCol].Field.DisplayText
    {$else}
      Text := Fields[LogCol].DisplayText
    {$endif}
    finally
      Datalink.ActiveRecord := OldActive
    end
  end;
  { If it is a cell, and in-place editor not present, }
  { and text is bigger than screen space, and not at design-time }
  Canvas.Font := Font;
  if (Text <> '') and not EditorMode and ForegroundTask and
     (Canvas.TextWidth(Text) + TextOffset > ColWidths[Col]) and
     not (csDesigning in ComponentState) then
  begin
    { Make sure hint window exists }
    if not Assigned(FHintWnd) then
    begin
      FHintWnd := HintWindowClass.Create(Self);
      FHintWnd.Color := Application.HintColor;
    end;
    { Set hint text }
    Hint := Text;
    { Calculate rect size }
    R := CalcHintRect(Screen.Width, Hint, FHintWnd);
    { Find target location }
    Pt := ClientToScreen(CellRect(Col, Row).TopLeft);
    { Tweak position so it is the same as the grid cell (hopefully) }
  {$ifdef DelphiLessThan3}
    Inc(Pt.Y);
  {$else}
    Dec(Pt.X);
    Dec(Pt.Y);
  {$endif}
    OffsetRect(R, Pt.X, Pt.Y);
    { Only draw it if it has moved - compare top-left }
    { (could compare whole rect but the hint sometimes grows itself) }
    GetWindowRect(FHintWnd.Handle, OldR);
    if not IsWindowVisible(FHintWnd.Handle) or
       not ((R.Left = OldR.Left) and (R.Top = OldR.Top)) then
      FHintWnd.ActivateHint(R, Hint)
  end
  else
    if Assigned(FHintWnd) then
      FHintWnd.ReleaseHandle
end;

procedure THintDBGrid.WMMouseMove(var Msg: TWMMouseMove);
begin
  inherited;
  DoHint(Msg.XPos, Msg.YPos)
end;

{$ifdef DelphiLessThan3}
{ TCustomHint }

procedure TCustomHint.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not ws_Disabled;
end;

procedure TCustomHint.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  Msg.Result := HTTRANSPARENT;
end;

initialization
  Application.ShowHint := not Application.ShowHint;
  HintWindowClass := TCustomHint;
  Application.ShowHint := not Application.ShowHint;
{$endif}
end.